home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vcls / smiley / smiley.pas < prev    next >
Pascal/Delphi Source File  |  1996-04-08  |  4KB  |  132 lines
  1. {-------------------------------------------------}
  2. {                                                 }
  3. {    The TSmiley component is Copyright ⌐ 1995    }
  4. {         by Nick Hodges All Rights Reserved      }
  5. {                                                 }
  6. {-------------------------------------------------}
  7.  
  8. unit Smiley;
  9.  
  10. {$R Smiley.res}
  11.  
  12. interface
  13.  
  14. uses  WinProcs, Classes, Graphics, Controls, StdCtrls, Messages, ExtCtrls;
  15.  
  16. procedure Register;
  17.  
  18. type
  19.     TMood = (smHappy, smSad, smShades, smTongue, smIndifferent, smOoh);
  20.  
  21. const
  22.      MoodString : array[tMood] of PChar = ('smHappy', 'smSad', 'smShades', 'smTongue', 'smIndifferent', 'smOoh');
  23.      MaxHeight = 26;
  24.      MaxWidth = 26;
  25.  
  26. type
  27.   TSmiley = class(TImage)
  28.   private
  29.     { Private declarations }
  30.     Face         : TBitmap;
  31.     FMood,
  32.         OldMood      : TMood;
  33.     procedure SetBitmap;
  34.     procedure SetMood(NewMood: TMood);
  35.         procedure WMSize (var Message: TWMSize); message wm_paint;
  36.   public
  37.     { Public declarations }
  38.         constructor Create(AOwner: TComponent); override;
  39.         destructor Free; 
  40.         procedure Toggle;
  41.         procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  42.         procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  43.   published
  44.         property Mood: TMood read FMood write SetMood;
  45.   end;
  46.  
  47.  
  48. implementation
  49.  
  50. Uses Choose, DsgnIntf;
  51.  
  52. {-------------------------------------------------
  53.                         TSmiley
  54. --------------------------------------------------}
  55.  
  56. constructor TSmiley.Create(AOwner: TComponent);
  57. begin
  58.      inherited Create(AOwner);
  59.      FMood := smHappy;
  60.      Face := TBitmap.Create;  {Note dynamic allocation of the pointer}
  61.      Face.Handle := LoadBitmap(hInstance, 'Happy'); {Old-fashioned API call}
  62.      Self.Height := MaxHeight;
  63.      Self.Width := MaxWidth;
  64.      SetBitmap;
  65.      OldMood := smHappy;
  66. end; {Create}
  67.  
  68. destructor TSmiley.Free;
  69. begin
  70.      Face.Free; {Use Free rather than Destroy, as Free checks for a nil pointer first}
  71.      inherited Free;
  72. end; {Free}
  73.  
  74. procedure TSmiley.Toggle;
  75. begin
  76.      if fMood = smOoh then fMood := smHappy else Inc(fMood);  {Don't allow fMood to overflow}
  77.      SetBitmap;
  78. end; {Toggle}
  79.  
  80. procedure TSmiley.SetBitmap;
  81. begin
  82.      Face.Handle := LoadBitmap(hInstance, MoodString[fMood]);
  83.      Self.Picture.Graphic := Face as TGraphic;  {Use RTTI to cast face as TGraphic, needed by TImage}
  84. end; {SetBitmap}
  85.  
  86. procedure TSmiley.SetMood(NewMood: TMood);
  87. begin
  88.      FMood := NewMood;
  89.      SetBitmap;
  90. end; {SetMood}
  91.  
  92. {This method will respond to a mouse push on the Smiley by storing the
  93. old face for later use and giving the "Sad" face.  Smileys don't like to get
  94. clicked on!}
  95. procedure TSmiley.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  96. begin
  97.      inherited MouseDown(Button, Shift, X, Y);
  98.      OldMood := Mood;
  99.      SetMood(smSad);
  100. end; {MouseDown}
  101.  
  102. {This method restores the old face when the mouse comes back up}
  103. procedure TSmiley.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  104. begin
  105.      inherited MouseUp(Button, Shift, X, Y);
  106.      SetMood(OldMood);
  107. end; {MouseUp}
  108.  
  109. {This method keeps the user from sizing the Smiley at design time.
  110. You can use the 'csDesigning in ComponentState' to control what the
  111. user can do at design time}
  112. procedure TSmiley.WMSize(var Message: TWMSize);
  113. begin
  114.      inherited;
  115.      if (csDesigning in ComponentState) then
  116.      begin
  117.           Width := MaxWidth;
  118.           Height := MaxHeight;
  119.      end;
  120. end; {WMSize}
  121.  
  122. {------------------------------------}
  123.  
  124. procedure Register;
  125. begin
  126.   RegisterComponents('Custom', [TSmiley]);
  127.   RegisterPropertyEditor( TypeInfo( TMood ), TSmiley, 'Mood', TMoodProperty );
  128. end; {Register}
  129.  
  130. end.
  131.  
  132.